unit funcao;

INTERFACE

uses Sysutils,Math;

type
  T_funcao=(F_X, F_C, SOMA, SUBT, MULT, DIVI, POTE, SEN, COSE,
	       TANG, SECAN, COSEC, COTAN, SENH, COSEH, TANGH,ARCTANG,
	       LNE, EXPO, LOG, ABSO, Raiz, SQR);
  Parvore=^arvore;
  arvore = record
    funcao:T_funcao;
    valor:extended;
    esq, dir:Parvore;
  end;

  Tfuncao=object
  private
    no:Parvore;
    erro:boolean;
    function insere(f:string):Parvore;
    function calcula_no(novo:Parvore; x:extended;var er:boolean):extended;
    procedure insere_negativo(var f:string);
    procedure insere_menos(var f:string);
    function elimina_pare(var fu:string):integer;
    function procura_soma(f:string):Parvore;
    function procura_div(f:string):Parvore;
    function procura_pot(f:string):Parvore;
    function procura_funcao(f:string):Parvore;
    function procura_x_n(f:string):Parvore;
    procedure limpa(var novo:Parvore);
  public
    Constructor funcao;
    Destructor destroy;
    function inicializa(f1:string):boolean;
    function calcula(x:real; var er:boolean):extended;
    procedure limpa_no;
    function get_erro:boolean;
    function get_no:Parvore;
  end;

IMPLEMENTATION

constructor Tfuncao.funcao;
begin
  no:=nil;
  erro:=false;
end;

destructor TFuncao.destroy;
begin
  limpa(no);
end;

function Tfuncao.get_no;
begin
  get_no:=no;
end;

function Tfuncao.get_erro;
begin
  get_erro:=erro;
end;

function Tfuncao.procura_soma(f:string):Parvore;
var
  i,p:integer;
  f1,f2:string;
  ch:char;
  novo:Parvore;
begin
  i:=1;
  p:=0;
  while (i<>0) do
  begin
   i:=elimina_pare(f);
   if(i=-1) then
   begin
     erro:=true;
     procura_soma:=nil;
     exit;
   end;
  end;
  i:=0;
  f1:=f;
  while(i<length(f))do
  begin
    if(f[i]='(') then
      p:=p+1
    else
    if(f[i]=')') then
      p:=p-1;
    if( ((f[i]='+')or(f[i]='-'))and(p=0) ) then
      begin
           new(novo);
           novo^.dir:=nil;
           novo^.esq:=nil;
           f:=f1;
           ch:=f[i];
           f1:=copy(f,1,i-1);
           f2:=copy(f,i+1,length(f)-1);
           if (f1<>'') then
             novo^.esq:=insere(f1);
           novo^.dir:=insere(f2);
           if ch='+' then
             novo^.funcao:=SOMA
           else
             novo^.funcao:=SUBT;
           procura_soma:=novo;
           exit;
    end;
    i:=i+1;
  end;
  procura_soma:=nil;
end;

function Tfuncao.procura_div(f:string):Parvore;
var
  i,p:integer;
  f1,f2:string;
  ch:char;
  novo:Parvore;
begin
  i:=1;
  p:=0;
  while(i<>0)do
  begin
         i:=elimina_pare(f);
	 if(i=-1)then
         begin
           erro:=true;
           procura_div:=nil;
           exit;
	 end;
  end;
  i:=0;
  f1:=f;
  while(i<length(f))do
   begin
    if(f[i]='(') then
      p:=p+1
    else
    if(f[i]=')') then
      p:=p-1;
    if( ((f[i]='*')or(f[i]='/'))and(p=0) )then
      begin
           new(novo);
           novo^.dir:=nil;
           novo^.esq:=nil;
           f:=f1;
           ch:=f[i];
           f1:=copy(f1,1,i-1);
           f2:=copy(f,i+1,length(f)-i);
           novo^.esq:=insere(f1);
           if novo^.esq=nil then
            erro:=true;
           novo^.dir:=insere(f2);
           if novo^.dir=nil then
            erro:=true;
           if ch='*' then
             novo^.funcao:=MULT
           else  novo^.funcao:=DIVI;
           procura_div:=novo;
           exit;
    end;
    i:=i+1;
  end;
  procura_div:=nil;
end;

function Tfuncao.procura_pot(f:string):Parvore;
var
  i,p:integer;
  f1,f2:string;
  ch:char;
  novo:Parvore;
begin
  i:=elimina_pare(f);
  p:=0;
  while(i<>0)do
  begin
   i:=elimina_pare(f);
   if(i=-1)then
   begin
     erro:=true;
     procura_pot:=nil;
     exit;
   end;
  end;
  i:=0;
  f1:=f;
  while(i<length(f))do
  begin
    if(f[i]='(') then
      p:=p+1
    else
    if(f[i]=')') then
      p:=p-1;
    if( (f[i]='^')and(p=0) )then
      begin
           new(novo);
           f:=f1;
           f1:=copy(f,1,i-1);
           f2:=copy(f,i+1,length(f)-i);
           novo^.esq:=insere(f1);
           if novo^.esq=nil then
             erro:=true;
           novo^.dir:=insere(f2);
           if novo^.dir=nil then
             erro:=true;
           novo^.funcao:=POTE;
           procura_pot:=novo;
           exit;
    end;
    i:=i+1;
  end;
  procura_pot:=nil;
end;


function Tfuncao.procura_funcao(f:string):Parvore;
var
  i:integer;
  f1,func:string;
  novo:Parvore;
begin
  i:=1;
  while(i<>0)do
  begin
     i:=elimina_pare(f);
     if(i=-1)then
     begin
       erro:=true;
       procura_funcao:=nil;
       exit;
     end;
  end;
  i:=0;
  f1:=f;
  func:=copy(f,1,6);
  if(func='arctan')then
  begin
	 new(novo);
	 novo^.funcao:=ARCTANG;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f1,7,length(f)-5);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  func:=copy(f,1,5);
  if(func='cosec')then
  begin
	 new(novo);
	 novo^.funcao:=COSEC;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,6,length(f)-4);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='secan')then
  begin
	 new(novo);
	 novo^.funcao:=SECAN;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-4);
         novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;

  if(func='cotan')then
  begin
	 new(novo);
	 novo^.funcao:=COTAN;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,6,length(f)-4);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;

  func:=copy(f,1,4);
  if(func='senh')then
  begin
	 new(novo);
	 novo^.funcao:=SENH;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,5,length(f)-3);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='sqrt')then
  begin
	 new(novo);
	 novo^.funcao:=RAIZ;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,5,length(f)-3);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='cosh')then
  begin
	 new(novo);
	 novo^.funcao:=COSEH;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,5,length(f)-3);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='tanh')then
  begin
	 new(novo);
	 novo^.funcao:=TANGH;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,5,length(f)-3);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  func:=copy(f,1,3);
  if(func='sen')then
  begin
	 new(novo);
	 novo^.funcao:=SEN;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='cos')then
  begin
	 new(novo);
	 novo^.funcao:=COSE;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='exp')then
  begin
	 new(novo);
	 novo^.funcao:=EXPO;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='sqr')then
  begin
	 new(novo);
	 novo^.funcao:=SQR;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
         novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='tan')then
  begin
	 new(novo);
	 novo^.funcao:=TANG;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='log')then
  begin
	 new(novo);
	 novo^.funcao:=LOG;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='abs')then
  begin
	 new(novo);
	 novo^.funcao:=ABSO;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,4,length(f)-2);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  func:=copy(f,1,2);
  if(func='ln')then
  begin
	 new(novo);
	 novo^.funcao:=LNE;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,3,length(f)-1);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  if(func='tg')then
  begin
	 new(novo);
	 novo^.funcao:=TANG;
	 novo^.esq:=nil;
	 f:=f1;
	 f1:=copy(f,3,length(f)-1);
	 novo^.dir:=insere(f1);
         if novo^.dir=nil then
           erro:=true;
	 procura_funcao:=novo;
         exit;
  end;
  procura_funcao:=nil;
end;



function Tfuncao.procura_x_n(f:string):Parvore;
var
  novo:Parvore;
  i,t:integer;
begin
  i:=1;
  while(i<>0)do
  begin
   i:=elimina_pare(f);
   if(i=-1)then
   begin
     erro:=true;
     procura_x_n:=nil;
     exit;
   end;
  end;
  if(f='x')then
  begin
     new(novo);
     novo^.funcao:=F_X;
     novo^.dir:=nil;
     novo^.esq:=nil;
     procura_x_n:=novo;
     exit;
  end;
  i:=1;
  while(i<length(f)) do
   begin
	 if not(f[i] in ['0'..'9']) then
         begin
           if(f[i]=',') then
              f[i]:='.'
           else if(f[i]<>'.') then
           begin
               erro:=true;
	       procura_x_n:=nil;
               exit;
           end;
	 end;
	 i:=i+1;
  end;
  new(novo);
  //novo^.valor:=strtofloat(f);
  val(f,novo^.valor,t);
  novo^.funcao:=F_C;
  novo^.dir:=nil;
  novo^.esq:=nil;
  procura_x_n:=novo;
end;


function Tfuncao.elimina_pare(var fu:string):integer;
var
  i,p,g,t:integer;
  f:string;
begin
  i:=1;
  p:=0;
  g:=0;
  t:=length(fu);
  f:=fu;
  if(f[1]<>'(') then
    begin
    elimina_pare:=0;
    exit;
    end;
  while( i<=t+1 )do
    begin
     if(f[i]='(')then
      p:=p+1
     else if(f[i]=')')then
           begin
            if(p=0) then
              begin
              elimina_pare:=-1;
              exit;
              end;
            if(i=t)then
              begin
                 if(g=0) then
                 begin
                   f:=copy(f,2,length(f)-1);
                   delete(f,i-1,i);
                   t:=length(f);
                   fu:=f;
                   elimina_pare:=1;
                   exit;
                end;
              end;
            p:=p-1;
            if(p=0) then
              g:=g+1;
     end;
     i:=i+1;
  end;
  fu:=f;
  elimina_pare:=0;
end;

procedure Tfuncao.insere_menos(var f:string);
var
  f1:string;
begin
  f1:='(-1)*';
  f1:=f1+f;
  f:=f1;
end;


procedure Tfuncao.insere_negativo(var f:string);
var
 i,j:integer;
 aux:string;
begin
  j:=length(f);
  i:=0;
  while(i<j)do
  begin
    if(f[i]='-')then
     begin
      f[i]:='+';
      aux:=copy(f,i+1,length(f));
      delete(f,i+1,length(f));
      insere_menos(aux);
      f:=f+aux;
      i:=i+3;
    end
    else i:=i+1;
  end;
end;

function Tfuncao.inicializa(f1:string):boolean;
var
  f:string;
  j:integer;
begin
  limpa_no;
  erro:=false;
  if(f1='')then
  begin
    inicializa:=false;
    exit;
  end;
  f:=f1;
  insere_negativo(f);
  f:=LowerCase(f);
  f:=trim(f);
  no:=insere(f);
  if erro then
   limpa_no;
  inicializa:=erro;
end;

function Tfuncao.insere(f:string):Parvore;
var
  novo:Parvore;
begin
  if(f='') then
   begin
    insere:=nil;
    erro:=true;
   end
  else
  begin
    novo:=procura_soma(f);
    if(novo<>nil)then
     begin
      insere:=novo;
      exit;
     end;
    novo:=procura_div(f);
    if(novo<>nil)then
     begin
      insere:=novo;
      exit;
     end;
    novo:=procura_pot(f);
    if(novo<>nil)then
     begin
      insere:=novo;
      exit;
     end;
    novo:=procura_funcao(f);
    if(novo<>nil)then
     begin
      insere:=novo;
      exit;
     end;
    novo:=procura_x_n(f);
    if(novo<>nil)then
     begin
      insere:=novo;
      exit;
     end;
  end;
    erro:=true;
    insere:=nil;
end;

function Tfuncao.calcula(x:real; var er:boolean):extended;
begin
   er:=false;
   if(no<>nil)then
    calcula:=calcula_no(no,x, er)
   else
   begin
    er:=true;
    calcula:=0;
   end;
end;

function Tfuncao.calcula_no(novo:Parvore; x:extended; var er:boolean):extended;
var
 d,e:extended;
 ex:integer;
begin
  d:=0;
  e:=0;
  if(novo^.dir<>nil) then
    d:=calcula_no(novo^.dir,x, er);
  if(novo^.esq<>nil) then
    e:=calcula_no(novo^.esq,x, er);
  case novo^.funcao of
    F_X:calcula_no:=x;
    F_C:calcula_no:=novo^.valor;
    SOMA:calcula_no:=(e+d);
    SUBT:calcula_no:=(e-d);
    MULT:calcula_no:=(e*d);
    DIVI:if(d=0)then
         begin
         er:=true;
         calcula_no:=0;
         end
         else calcula_no:=(e/d);
    POTE:if e<0 then
          begin
           ex:=round(d);
           d:=exp(ex*ln(abs(e)));
           if(ex mod 2)<>0 then
             calcula_no:=(-d)
           else calcula_no:=(d);
          end
          else
          if d=0 then
             calcula_no:=(1)
          else
             if (e=0)then
                calcula_no:=(0)
               else calcula_no:=(exp(ln(e)*d));
     SEN:calcula_no:=( sin(d) );
     EXPO:calcula_no:=( exp(d) );
     COSE:calcula_no:=( cos(d) );
     TANG:calcula_no:=( tan(d) );
     SECAN:calcula_no:=(1/cos(d));
     COSEC:if(d=0) then
            begin
            er:=true;
            calcula_no:=(0);
            end
            else calcula_no:=(1/sin(d));
     COTAN:if(d=0)then
            begin
            er:=true;
            calcula_no:=(0);
            end
            else calcula_no:=(1/tan(d));
     SENH:calcula_no:=(sinh(d));
     COSEH:calcula_no:=(cosh(d));
     TANGH:calcula_no:=(tanh(d));
     ARCTANG:calcula_no:=(ArcTan(d));
     LNE: if(d<=0) then
          begin
          er:=true;
          calcula_no:=(0);
          end
          else calcula_no:=(ln(d));
     LOG:if(d<=0)then
         begin
          er:=true;
          calcula_no:=(0);
         end
         else calcula_no:=(log10(d));
     ABSO:calcula_no:=(abs(d));
     RAIZ: if(d>=0)then
     	     calcula_no:=(sqrt(d))
           else
           begin
            er:=true;
            calcula_no:=(0);
           end;
     SQR:calcula_no:=(d*d);
     else calcula_no:=(0);
    end;
end;

procedure Tfuncao.limpa_no;
begin
  limpa(no);
end;

procedure Tfuncao.limpa(var novo:Parvore);
begin
  if(novo<>nil)then
  begin
    if(novo^.dir<>nil) then
      limpa(novo^.dir);
    if(novo^.esq<>nil) then
      limpa(novo^.esq);
    dispose(novo);
    novo:=nil;
  end;
end;

end.
